home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2005 June / PCpro_2005_06.ISO / files / opensource / amc / amc_install.exe / {app} / Scripts / Adult DVD Empire.ifs < prev    next >
Encoding:
Text File  |  2005-03-12  |  17.5 KB  |  536 lines
  1. (***************************************************
  2.  
  3. Ant Movie Catalog importation script
  4. www.antp.be/software/moviecatalog/
  5.  
  6. [Infos]
  7. Authors=KaraGarga
  8. Title=Adult DVD Empire
  9. Description=Adult DVD Empire
  10. Site=http://www.adultdvdempire.com/
  11. Language=EN
  12. Version=0.3 / 10.2004
  13. Requires=3.5.0
  14. Comments=Based on Twink's ADME script|TwinkMan666@hotmail.com|Re-written by KaraGarga|karagarga@gmail.com
  15. License=This program is free software; you can redistribute it and/or modify it under the  terms of the GNU General Public License as published by the Free Software Foundation;  either version 2 of the License, or (at your option) any later version. |
  16. GetInfo=1
  17.  
  18. [Options]
  19.  
  20. ***************************************************)
  21.  
  22. program ADE;
  23.  
  24. const                   
  25.   ImportSynopsis = True;  {into "Description" field}
  26.   ImportADEReview = True; {into "Comments" field}
  27.   ImportCustomerComment = True; {into "Comments" field}
  28.   ImportBigCover = True;
  29.   ImportSmallCover = False;
  30.   ImportRunTime = False;
  31.   ImportDVDDetails =True; {into "Description" field}
  32.   {True = imports related data
  33.   False = NOT import related data}
  34.  
  35. var
  36.   MovieName: string;
  37.  
  38. function FindLine(Pattern: string; List: TStringList; StartAt: Integer): Integer;
  39. var
  40.   i: Integer;
  41. begin
  42.   result := -1;
  43.   if StartAt < 0 then
  44.     StartAt := 0;
  45.   for i := StartAt to List.Count-1 do
  46.     if Pos(Pattern, List.GetString(i)) <> 0 then
  47.     begin
  48.       result := i;
  49.       Break;
  50.     end;
  51. end;
  52.  
  53. function StringReplaceAll(S, Old, New: string): string;
  54. begin
  55.   while Pos(Old, S) > 0 do
  56.     S := StringReplace(S, Old, New);
  57.   Result := S;
  58. end;
  59. procedure CutAfter(var Str: string; Pattern: string);
  60. begin
  61.   Str := Copy(str, Pos(Pattern, Str) + Length(Pattern), Length(Str));
  62. end;
  63. procedure CutBefore(var Str: string; Pattern: string);
  64. begin
  65.   Str := Copy(Str, Pos(Pattern, Str), Length(Str));
  66. end;
  67.  
  68. function GetStringFromHTML(Page, StartTag, CutTag, EndTag: string): string;
  69. begin
  70.   Result := '';
  71.   if Pos(StartTag, Page) > 0 then begin
  72.     CutBefore(Page, StartTag);
  73.     if Length(CutTag) > 0 then
  74.       CutAfter(Page, CutTag);
  75.       Result := Copy(Page, 0, Pos(EndTag, Page) - 1);
  76.       HTMLDecode(Result);
  77.   end;
  78. end;
  79.  
  80. procedure AnalyzePage(Address: string);
  81. var
  82.   Page: TStringList;
  83.   LineNr: Integer;
  84.   Line, Value: String;
  85.   BeginPos, EndPos: Integer;
  86. begin
  87.   Page := TStringList.Create;
  88.   Page.Text := GetPage(Address);
  89.   if pos('<title>Adult DVD Empire - Search - Titles</title>', Page.Text) = 0 then
  90.   begin
  91.     //SetField(fieldURL, Address);
  92.     AnalyzeMoviePage(Page)
  93.   end else
  94.   begin
  95.     PickTreeClear;
  96.     LineNr := 0;
  97.     if FindLine('searchID=',Page,0)>-1 then
  98.     begin
  99.       PickTreeAdd('Adult DVD Empire Title Search:', '');
  100.       repeat
  101.         repeat
  102.           LineNr := FindLine('searchID=', Page, LineNr+1);
  103.           if LineNr > -1 then
  104.           begin
  105.             AddMoviesTitles(Page, LineNr);
  106.           end;
  107.         until LineNr = -1 ;
  108.         // Check for the link of 'Next Page'
  109.         LineNr := FindLine('><nobr><a href=', Page, LineNr+1);
  110.         if LineNr > -1 then
  111.         begin
  112.           Line := Page.GetString(LineNr);
  113.           BeginPos := pos('><nobr><a href=', Line)+16;
  114.           Delete(Line, 1, BeginPos);
  115.           EndPos := pos('''>', Line);
  116.           Value := copy(Line, 1, EndPos - 1);
  117.           Page.Text := GetPage('http://www.adultdvdempire.com/' + Value);
  118.         end;
  119.       until LineNr = -1;
  120.     end;
  121.  
  122.     if PickTreeExec(Address) then
  123.       AnalyzePage(Address);
  124.   end;
  125.   Page.Free;
  126. end;
  127.  
  128. procedure AddMoviesTitles(Page: TStringList; var LineNr: Integer);
  129. var
  130.   Line, Line1: string;
  131.   MovieTitle, MovieAddress: string;
  132.   StartPos, StartPos1: Integer;
  133. begin
  134.  
  135.     Line := Page.GetString(LineNr+1);
  136.     Line1 := Page.GetString(LineNr);
  137.     StartPos := pos('</a>', Line);
  138.     StartPos1 := pos('item_id', Line1);
  139.     if StartPos > 0 then
  140.     begin
  141.       MovieAddress := copy(Line1, StartPos1, pos('">', Line1) - StartPos1);
  142.       StartPos := pos('">', Line) + 2;
  143.       MovieTitle := copy(Line, StartPos, pos('</a>', Line) - StartPos);
  144.       HTMLDecode(Movietitle);
  145.       if MovieTitle <> 'Add to Wish List' then
  146.        if MovieTitle <> '<b>Add to Order</b>' then
  147.       begin
  148.         setField(fieldURL, 'http://www.adultdvdempire.com/Exec/v1_item.asp?' + MovieAddress);
  149.         PickTreeAdd(MovieTitle, 'http://www.adultdvdempire.com/Exec/v1_item.asp?' + MovieAddress);
  150.       end;
  151.     end;
  152.  
  153. end;
  154.  
  155. procedure AnalyzeMoviePage(Page: TStringList);
  156. var
  157.   Line, Value, Value2, FullValue: string;
  158.   LineNr, ValueInt: Integer;
  159.   BeginPos, EndPos, DirectorPos, BrPos: Integer;
  160. begin
  161.  
  162. //--------------------------------------
  163. //URL
  164. //--------------------------------------
  165.  
  166.   LineNr := FindLine('v4_wishlist_additem.asp?',Page,0);
  167.   if LineNr >-1 then
  168.   begin
  169.     Line := Page.GetString(LineNr);
  170.     BeginPos := pos('item_id=', Line);
  171.     Delete(Line, 1, BeginPos);
  172.     EndPos := pos('">', Line);
  173.     Value := copy(Line, 1, EndPos - 1);
  174.     setField(fieldURL,'http://www.adultdvdempire.com/exec/v1_item.asp?i'+Value);
  175.   end;
  176.  
  177. //---------------------
  178. //Original Title
  179. //---------------------
  180.  
  181.   LineNr := FindLine('<title>Adult DVD Empire - ',Page,0);
  182.   if LineNr >-1 then
  183.   begin
  184.     Line := Page.GetString(LineNr);
  185.     BeginPos := pos('ire -', Line)+5;
  186.     Delete(Line, 1, BeginPos);
  187.     EndPos := pos(' - Adult', Line);
  188.     Value := copy(Line, 1, EndPos - 1);
  189.     setField(fieldOriginalTitle,Value);
  190.   end;
  191.  
  192.  
  193. //------------------------------------
  194. // Big Cover (adjust in "const" field)
  195. //--------------------------------------
  196.  
  197.   if ImportBigCover then
  198.   begin
  199.   LineNr := FindLine('<img src="http://images.dvdempire.com/res/movies/', Page, 0);
  200.   if LineNr > -1 then
  201.   begin
  202.     Line := Page.GetString(LineNr);
  203.     BeginPos := pos('src="', Line) + 4;
  204.     Delete(Line, 1, BeginPos);
  205.     EndPos := pos('.jpg"', Line);
  206.     Value := copy(Line, 1, EndPos - 1);
  207.     GetPicture(Value+'h.jpg');
  208.     // False = do not store picture externally ; store it in the catalog file
  209.   end
  210.   else ShowMessage('Sorry Cover not available!');
  211.   end;
  212.  
  213. //------------------------------------
  214. // Small Cover (adjust in "const" field)
  215. //--------------------------------------
  216.  
  217.   if ImportSmallCover then
  218.   begin
  219.   LineNr := FindLine('<img src="http://images.dvdempire.com/res/movies/', Page, 0);
  220.   if LineNr > -1 then
  221.   begin
  222.     Line := Page.GetString(LineNr);
  223.     BeginPos := pos('src="', Line) + 4;
  224.     Delete(Line, 1, BeginPos);
  225.     EndPos := pos('"', Line);
  226.     Value := copy(Line, 1, EndPos - 1);
  227.     GetPicture(Value);
  228.     // False = do not store picture externally ; store it in the catalog file
  229.   end
  230.   else ShowMessage('Sorry Cover not available!');
  231.   end;
  232.  
  233.  
  234. //-----------------------------------------------
  235. //Actors & Director
  236. //-----------------------------------------------
  237.  
  238.   LineNr := FindLine('<td class="fontsmall3" valign="top" width="100%" nowrap>',Page,0);
  239.   if LineNr > -1 then
  240.   begin
  241.     Line := Page.GetString(LineNr+1);
  242.     BeginPos := pos('ò ', Line)+12;
  243.     Delete(Line, 1, BeginPos);
  244.     FullValue := '';
  245.     Value := '';
  246.     repeat
  247.       BeginPos := pos('sort=2', Line);
  248.       Delete(Line, 1, BeginPos+7);
  249.       BrPos := pos('<br>', Line);
  250.       EndPos := pos('</a>', Line);
  251.       Value := copy(Line, 1, EndPos - 1);
  252.       if pos('Director', copy(Line, 1, BrPos - 1)) <> 0 then
  253.         setField(fieldDirector, Value)
  254.       else
  255.         FullValue := FullValue + Value + #13#10;
  256.  
  257.  
  258.       Delete(Line, 1, BrPos);
  259.     until Line = '';
  260.    
  261.     HTMLDecode(FullValue);
  262.     setField(fieldActors,FullValue);
  263.   end;
  264.  
  265. //-----------------------------------------------
  266. //Length
  267. //-----------------------------------------------
  268.   if ImportRunTime then
  269.   begin
  270.   LineNr := FindLine('Length:',Page,0);
  271.   if LineNr > -1 then
  272.   begin
  273.     Line := Page.GetString(LineNr);
  274.     Line := RemoveHTMLCrap(Line);
  275.     BeginPos := pos(':', Line);
  276.     Delete(Line, 1, BeginPos);
  277.     EndPos := pos(#13#10, Line);
  278.     Value := trim(copy(Line, 1, EndPos - 1));
  279.     if Value <> 'N/A' then
  280.     begin
  281.       Value := RemoveHTMLCrap(Value);
  282.       BeginPos := pos(' hrs', Value);
  283.       EndPos := pos(' mins', Value);
  284.       ValueInt := StrToInt(Copy(Value, 1, BeginPos - 1), 0) * 60 + StrToInt(Copy(Value, BeginPos + 5, EndPos - BeginPos - 5), 0);
  285.       Value := IntToStr(ValueInt);
  286.       setField(fieldLength,Value);
  287.     end;
  288.   end;
  289.   end;
  290.  
  291. //-----------------------------------------------
  292. //Rating
  293. //-----------------------------------------------
  294.   LineNr := FindLine('Overall Rating:',Page,0);
  295.   if LineNr > -1 then
  296.   begin
  297.     Line := Page.GetString(LineNr+4);
  298.     BeginPos := pos('">', Line)+2;
  299.     Delete(Line, 1, BeginPos - 1);
  300.     EndPos := pos(' out', Line);
  301.     Value := IntToStr(Round((StrToInt(copy(Line,1,1), 0) + StrToInt(Copy(Line, 3, endpos-3), 0)/100)*2));
  302.     SetField(fieldRating, Value);
  303.   end;
  304.  
  305.  
  306. //-----------------------------------------------
  307. //Year
  308. //-----------------------------------------------
  309.   LineNr := FindLine('Production Year:',Page,0);
  310.   Value := '';
  311.   if LineNr > -1 then
  312.   begin
  313.     Line := Page.GetString(LineNr);
  314.     Line := RemoveHTMLCrap(Line);
  315.     BeginPos := pos(': ', Line);
  316.     if BeginPos > 0 then
  317.     begin
  318.       Delete(Line, 1, BeginPos + 1);
  319.       EndPos := pos(#13#10, Line);
  320.       Value := trim(Copy(Line, 1, EndPos - 1));
  321.     end;
  322.   end;
  323.  
  324.   // If we didn't find a production year, use the release date instead
  325.   if Value = '' then
  326.   begin
  327.     LineNr := FindLine('Release Date:',Page,0);
  328.     if LineNr > -1 then
  329.     begin
  330.       Line := Page.GetString(LineNr);
  331.       Line := RemoveHTMLCrap(Line);
  332.       BeginPos := pos('/', Line);
  333.       if BeginPos > 0 then
  334.       begin
  335.         Delete(Line, 1, BeginPos);
  336.         BeginPos := pos('/', Line);
  337.         if BeginPos > 0 then
  338.         begin
  339.           Delete(Line, 1, BeginPos);
  340.           EndPos := pos(#13#10, Line);
  341.           Value := trim(Copy(Line, 1, EndPos - 1));
  342.         end;
  343.       end;
  344.     end;
  345.   end;
  346.  
  347.   if Value <> '' then
  348.     SetField(fieldYear, Value);
  349.  
  350.  
  351. //-----------------------------------------------
  352. //Category
  353. //-----------------------------------------------
  354.   LineNr := FindLine('Rating:<font color="white">i</font>', Page, 0);
  355.   if LineNr > -1 then
  356.   begin
  357.     Line := Page.GetString(LineNr);
  358.     BeginPos := Pos('</font>',Line)+7;
  359.     Value := Copy(Line, BeginPos,8);
  360.     Value:=StringReplace(Value, '<br>', '');
  361.     SetField(fieldCategory, Value);
  362.   end;
  363.  
  364. //-----------------------------------------------
  365. // Studio
  366. //-----------------------------------------------
  367.   LineNr := FindLine('<td class="fontsmall" valign="top" align="left" nowrap>', Page, 0);
  368.   if LineNr > -1 then
  369.   begin
  370.     Value := Page.GetString(LineNr + 1);
  371.     Value:=StringReplace(Value, '            ', '');
  372.     Value:=StringReplace(Value, ' ', '');
  373.     Value:=StringReplace(Value, '<font face="verdana, arial, sans-serif" size="-1" color="#ffffff">i</font>', ' ');
  374.     HTMLDecode(Value);
  375.     HTMLRemoveTags(Value);
  376.     SetField(fieldProducer,Value);
  377.   end;
  378.  
  379. //-------------------------------------------------------
  380. // Description
  381. //-------------------------------------------------------
  382.  
  383.   LineNr := FindLine('<b>Synopsis</b>', Page, 0);
  384.   if LineNr > -1 then
  385.   begin
  386.     Value := Page.GetString(LineNr + 19)+#13#10+Page.GetString(LineNr + 20);
  387.     Value:=StringReplace(Value, '                           ', '');
  388.     Value:=StringReplace(Value, '<font face="verdana, arial, sans-serif" size="-1" color="#ffffff">i</font>', ' ');
  389.     Value := StringReplace(Value, #13#10, '');
  390.     Value := StringReplace(Value, '         ', '');
  391.     Value := StringReplace(Value, '   ', '');
  392.     Value := StringReplace(Value, 'à','...');
  393.     Value := StringReplace(Value, '<font color="white">i</font>',' ');
  394.     Value := StringReplace(Value, '<br>',#13#10);
  395.     Value := StringReplace(Value, '<BR>',#13#10);
  396.     Value := StringReplace(Value, '<Br>',#13#10);
  397.     Value := StringReplace(Value, '<bR>',#13#10);
  398.     HTMLDecode(Value);
  399.     HTMLRemoveTags(Value);
  400.     SetField(fieldDescription,Value+#13#10+#13#10);
  401.   end;
  402.  
  403.  
  404. //-------------------------------------------------------
  405. // DVD Product Information (into "Description" Field)
  406. //-------------------------------------------------------
  407.  
  408.   if ImportDVDDetails then
  409.   begin
  410.     LineNr := FindLine('<b>Features:</b><br>', Page, 0);
  411.     if LineNr > -1 then
  412.     begin
  413.     Value := GetField(fieldURL);
  414.     Page.Text := GetPage(Value);
  415.     Value:= GetStringFromHTML(Page.Text, '<b>Features:</b><br>', '<br>', 'Studio:');
  416.     Value := StringReplace(Value, #13#10, '');
  417.     Value := StringReplace(Value, '         ', '');
  418.     Value := StringReplace(Value, '   ', '');
  419.     Value := StringReplace(Value, 'à','...');
  420.     Value := StringReplace(Value, '<font color="white">i</font>',' ');
  421.     Value := StringReplace(Value, '<br>',#13#10);
  422.     Value := StringReplace(Value, '<BR>',#13#10);
  423.     Value := StringReplace(Value, '<Br>',#13#10);
  424.     Value := StringReplace(Value, '<bR>',#13#10);
  425.     HTMLRemoveTags(Value);
  426.     SetField(fieldDescription, GetField(fieldDescription)+'DVD DETAILS:'+#13#10+Value);
  427.     end;
  428.   end;
  429.  
  430. //-------------------------------------------------------
  431. // ADE (Adult DVD Empire) Review
  432. //-------------------------------------------------------
  433.   if ImportADEReview then
  434.   begin
  435.     LineNr := FindLine('Empire  Reviews</a>', Page, 0);
  436.     if LineNr > -1 then
  437.     begin
  438.     (*Line := Page.GetString(LineNr-1);
  439.     Value:= GetStringFromHTML(Line, '<a href', '="', '">');
  440.     HTMLDecode(Value); *)
  441.     Value := GetField(fieldURL)+'&tab=1';
  442.     Page.Text := GetPage(Value);
  443.     Value:= GetStringFromHTML(Page.Text, '<td class="fontsmall3" valign="top" width="100%">', '100%">', '   ');
  444.     Value := StringReplace(Value, #13#10, '');
  445.     Value := StringReplace(Value, '<br><br>', #13#10);
  446.     Value := StringReplace(Value, '      ', '');
  447.     Value := StringReplace(Value, '   ', '');
  448.     Value := StringReplace(Value, 'à','...');
  449.     Value := StringReplace(Value, 'ô','"');
  450.     Value := StringReplace(Value, 'ö','"');
  451.     Value := StringReplace(Value, '<BR>',#13#10);
  452.     Value := StringReplace(Value, '<Br>',#13#10);
  453.     Value := StringReplace(Value, '<bR>',#13#10);
  454.     HTMLRemoveTags(Value);
  455.     SetField(fieldComments, 'ADULT DVD EMPIRE REVIEW:'+#13#10+Value+#13#10+#13#10);
  456.     end;
  457.   end;
  458.  
  459. //-------------------------------------------------------
  460. // Customer Comments (Only first available comment-fully)
  461. //-------------------------------------------------------
  462.   if ImportCustomerComment then
  463.   begin
  464.     LineNr := FindLine('Customer Comments</a>', Page, 0);
  465.     if LineNr > -1 then
  466.     begin
  467.     (*Line := Page.GetString(LineNr-1);
  468.     Value:= GetStringFromHTML(Line, '<a href', '="', '">');
  469.     HTMLDecode(Value); *)
  470.     Value := GetField(fieldURL)+'&tab=2';
  471.     Page.Text := GetPage(Value);
  472.     LineNr := FindLine('<b>No Customer Comments.</b>', Page, 0);
  473.     if LineNr < 1 then
  474.     begin
  475.     Value:= GetStringFromHTML(Page.Text, '<td class="fontsmall3" valign="top" width="100%">', '100%">', '   ');
  476.     Value := StringReplace(Value, #13#10, '');
  477.     Value := StringReplace(Value, '<br><br>', #13#10);
  478.     Value := StringReplace(Value, '         ', '');
  479.     Value := StringReplace(Value, '<BR>',#13#10);
  480.     Value := StringReplace(Value, '<Br>',#13#10);
  481.     Value := StringReplace(Value, '<bR>',#13#10);
  482.     HTMLRemoveTags(Value);
  483.     SetField(fieldComments, GetField(fieldComments)+'CUSTOMER COMMENTS:'+#13#10+Value);
  484.     end;
  485.   end;
  486.   end;
  487.  
  488.   //DisplayResults;
  489. end;
  490.  
  491. // They've inserted some crap to make it harder to parse - like
  492. // a white 'i' instead of spaces.
  493. function RemoveHTMLCrap(htmlstring: string): string;
  494. begin
  495.   result := StringReplace(htmlstring, ' ',' ');
  496.   result := StringReplace(result, '<font color="white">i</font>',' ');
  497.   result := StringReplace(result, '<font face="verdana, arial, sans-serif" size="-1" color="#ffffff">i</font>',' ');
  498.   // Also remove italics, bold and underline tags
  499.   result := StringReplace(result, 'à','...');
  500.   result := StringReplace(result, 'ô','"');
  501.   result := StringReplace(result, 'ö','"');
  502.   result := StringReplace(result, '<i>','');
  503.   result := StringReplace(result, '</i>','');
  504.   result := StringReplace(result, '<u>','');
  505.   result := StringReplace(result, '</u>','');
  506.   result := StringReplace(result, '<b>','');
  507.   result := StringReplace(result, '</b>','');
  508.   result := StringReplace(result, '</B>','');
  509.   result := StringReplace(result, '<B>','');
  510.   result := StringReplace(result, '<BR>','');
  511.   result := StringReplace(result, '</BR>','');
  512.   result := StringReplace(result, '</I>','');
  513.   result := StringReplace(result, '<I>','');
  514.   result := StringReplace(result, 'û','-');
  515.   result := StringReplace(result, 'ô','');
  516.   result := StringReplace(result, 'ö','');
  517.   result := StringReplace(result, '<br>',#13#10);
  518.   result := StringReplace(result, '      ','');
  519.   result := StringReplace(result, #9,' ');  // Tab
  520. end;
  521.  
  522.  
  523. begin
  524.   if CheckVersion(3,5,0) then
  525.   begin
  526.     MovieName := GetField(fieldOriginalTitle);
  527.     if MovieName = '' then
  528.       MovieName := GetField(fieldTranslatedTitle);
  529.     if Input('Adult Movie Empire Import', 'Enter the title of the movie:', MovieName) then
  530.     begin
  531.       AnalyzePage('http://www.adultdvdempire.com/Exec/v1_search_titles.asp?string='+UrlEncode(MovieName));
  532.     end;
  533.   end else
  534.   ShowMessage('This script requires a newer version of Ant Movie Catalog (at least the version 3.5.0)');
  535. end.
  536.